home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / Net / Time.pm < prev   
Encoding:
Perl POD Document  |  1999-12-28  |  2.7 KB  |  124 lines

  1.  
  2. package Net::Time;
  3.  
  4. use strict;
  5. use vars qw($VERSION @ISA @EXPORT_OK $TIMEOUT);
  6. use Carp;
  7. use IO::Socket;
  8. require Exporter;
  9. use Net::Config;
  10. use IO::Select;
  11.  
  12. @ISA = qw(Exporter);
  13. @EXPORT_OK = qw(inet_time inet_daytime);
  14.  
  15. $VERSION = do { my @r=(q$Revision: 2.5 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
  16.  
  17. $TIMEOUT = 120;
  18.  
  19. sub _socket
  20. {
  21.  my($pname,$pnum,$host,$proto,$timeout) = @_;
  22.  
  23.  $proto ||= 'udp';
  24.  
  25.  my $port = (getservbyname($pname, $proto))[2] || $pnum;
  26.  
  27.  my $hosts = defined $host ? [ $host ] : $NetConfig{$pname . '_hosts'};
  28.  
  29.  my $me;
  30.  
  31.  foreach $host (@$hosts)
  32.   {
  33.    $me = IO::Socket::INET->new(PeerAddr => $host,
  34.                                PeerPort => $port,
  35.                                Proto    => $proto
  36.                               ) and last;
  37.   }
  38.  
  39.  $me->send("\n")
  40.     if(defined $me && $proto eq 'udp');
  41.  
  42.  $timeout = $TIMEOUT
  43.     unless defined $timeout;
  44.  
  45.  IO::Select->new($me)->can_read($timeout)
  46.     ? $me
  47.     : undef;
  48. }
  49.  
  50. sub inet_time
  51. {
  52.  my $s = _socket('time',37,@_) || return undef;
  53.  my $buf = '';
  54.  
  55.  
  56.  $s->recv($buf, length(pack("N",0)))
  57.     ? (unpack("N",$buf))[0] - 2208988800
  58.     : undef;
  59. }
  60.  
  61. sub inet_daytime
  62. {
  63.  my $s = _socket('daytime',13,@_) || return undef;
  64.  my $buf = '';
  65.  
  66.  $s->recv($buf, 1024) ? $buf
  67.                       : undef;
  68. }
  69.  
  70. 1;
  71.  
  72. __END__
  73.  
  74. =head1 NAME
  75.  
  76. Net::Time - time and daytime network client interface
  77.  
  78. =head1 SYNOPSIS
  79.  
  80.     use Net::Time qw(inet_time inet_daytime);
  81.     
  82.     print inet_time();        # use default host from Net::Config
  83.     print inet_time('localhost');
  84.     print inet_time('localhost', 'tcp');
  85.     
  86.     print inet_daytime();    # use default host from Net::Config
  87.     print inet_daytime('localhost');
  88.     print inet_daytime('localhost', 'tcp');
  89.  
  90. =head1 DESCRIPTION
  91.  
  92. C<Net::Time> provides subroutines that obtain the time on a remote machine.
  93.  
  94. =over 4
  95.  
  96. =item inet_time ( [HOST [, PROTOCOL [, TIMEOUT]]])
  97.  
  98. Obtain the time on C<HOST>, or some default host if C<HOST> is not given
  99. or not defined, using the protocol as defined in RFC868. The optional
  100. argument C<PROTOCOL> should define the protocol to use, either C<tcp> or
  101. C<udp>. The result will be a unix-like time value or I<undef> upon
  102. failure.
  103.  
  104. =item inet_daytime ( [HOST [, PROTOCOL [, TIMEOUT]]])
  105.  
  106. Obtain the time on C<HOST>, or some default host if C<HOST> is not given
  107. or not defined, using the protocol as defined in RFC867. The optional
  108. argument C<PROTOCOL> should define the protocol to use, either C<tcp> or
  109. C<udp>. The result will be an ASCII string or I<undef> upon failure.
  110.  
  111. =back
  112.  
  113. =head1 AUTHOR
  114.  
  115. Graham Barr <gbarr@ti.com>
  116.  
  117. =head1 COPYRIGHT
  118.  
  119. Copyright (c) 1995-1997 Graham Barr. All rights reserved.
  120. This program is free software; you can redistribute it and/or modify
  121. it under the same terms as Perl itself.
  122.  
  123. =cut
  124.